Gold Medal Software 3

home *** CD-ROM | disk | FTP | other *** search

/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / prog / dnalib59.arj / SAVEAS.BAS < prev next >

Wrap

BASIC Source File | 1994-02-13 | 21KB | 599 lines

DECLARE SUB LineEdit(Allow$,Text$,Mouse%,MouseRow%,MouseCol%,Fill%,Row%,Col%,EditKey%,Attr%) DECLARE SUB Popwind(Title$,Toprow%,Leftcolumn%,Bottomrow%,Rightcolumn%,Attr%,Shadow%,Border%) DECLARE SUB Dialog(Choices$(),Title$,Mouse%,Cntr%,TopRow%,LeftColumn%,TxtColor%,Attr%,Shadow%,Border%) DECLARE SUB RestoreScreen(ScreenID$,TopRow%,LeftColumn%) DECLARE SUB SaveScreen(ScreenID$,TopRow%,LeftColumn%,BottomRow%,RightColumn%,Shadow%) DECLARE SUB CalcByte(Attr%,LowByte%,HiByte%) DECLARE SUB Clicked(Rgt%,Lft%,Row%,Col%) DECLARE SUB HideCursor() DECLARE SUB ShowCursor() DECLARE FUNCTION LeftButtonReleased%() SUB WriteToBox(ReturnedFile$,DefaultName$,Mouse%,Attr%,BarAttr%,ButtonAttr%,Shadow%,Border%)PUBLIC DIM Directory$(1:100) DIM Message$(2) DirPointer% = 0 ON LOCAL ERROR GOTO ErrorHandle Allow$ = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_^$~!{}()@'`*.\:" FileMask$ = "*.*" CalcByte Attr%,FGround%,BGround% CalcByte ButtonAttr%,BtFG%,BtBG% CalcByte BarAttr%,BarFG%,BarBG% IF Mouse% THEN HideCursor SaveScreen DirScreen$,4,9,17,71,1 Popwind Title$,4,9,17,71,Attr%,Shadow%,Border% Popwind Title$,8,11,13,69,Attr%,0,1 IF Mouse% THEN COLOR FGround%,BGround% LOCATE 4,11,0 PRINT CHR$(91,254,93); END IF Row% = 15:Col% = 13 COLOR BtFG%,BGround% LOCATE 6,11,0 PRINT "File Name:"; COLOR BtFG%,BtBG% LOCATE Row%, Col%,0 PRINT " Enter "; COLOR 0,BGround% LOCATE Row%, Col% + 7,0 PRINT "▄"; COLOR 0,BGround% LOCATE Row% + 1,Col% + 1,0 PRINT "▀▀▀▀▀▀▀"; COLOR BtFG%,BtBG% LOCATE Row%,Col% + 11,0 PRINT " Esc "; COLOR 0,BGround% LOCATE Row%,Col% + 16,0 PRINT "▄"; COLOR 0,BGround% LOCATE Row% + 1,Col% + 12,0 PRINT "▀▀▀▀▀" IF RIGHT$(CURDIR$,1) = "\" THEN 'make sure there is a back slash Current$ = CURDIR$ + "*.*" ELSE Current$ = CURDIR$ + CHR$(92) + "*.*" END IF DO IF DirCount% THEN 'empty out the array FOR i% = 1 TO DirCount% Directory$(i%) = "" NEXT i% END IF FOR i% = 1 TO LEN(Current$) 'get the path, need this when testing ATTRIB Test$ = RIGHT$(Current$,i%) IF LEFT$(Test$,1) = CHR$(92) THEN Path$ = LEFT$(Current$,LEN(Current$) - (i% - 1)) EXIT FOR END IF NEXT i% i% = 1 DirName$ = DIR$(Path$ + "*.*",16) 'get directorys and put them in an array x% = ATTRIB(Path$ + DirName$) IF x% = 16 THEN Directory$(i%) = DirName$ DO DirName$ = DIR$ IF LEN(DirName$) THEN x% = ATTRIB(Path$ + DirName$) IF x% = 16 THEN INCR i% Directory$(i%) = DirName$ END IF END IF LOOP WHILE LEN(DirName$) IF LEN(Path$) > 3 THEN IF LEN(Directory$(i%)) THEN INCR i% Directory$(i%) = ".." ELSE Directory$(i%) = ".." END IF END IF DirCount% = i% 'keep a count of directorys ARRAY SORT Directory$(1) FOR DirCount% 'sort them A - Z PasteIn$ = "" DirStart% = 1:DirFinish% = 16 'initialize these DO IF Mouse% THEN HideCursor GOSUB PrintDirs Current$ = Path$ + PasteIn$ + DefaultName$ 'display the full path and file name IF LEN(Current$) < 48 THEN 'of the selected item Add% = 48 - LEN(Current$) Current$ = Current$ + SPACE$(Add%) END IF Current$ = UCASE$(Current$) 'force upper case Editkey% = 0 'this causes LineEdit to print and exit LineEdit Allow$,Current$,Mouse%,MouseRow%,MouseCol%,176,6,22,EditKey%,BarAttr% Kurrent$ = Current$ Kurrent$ = RTRIM$(Kurrent$) FOR i% = 1 TO LEN(Kurrent$) 'get the path and file name Test$ = RIGHT$(Kurrent$,i%) IF LEFT$(Test$,1) = CHR$(92) THEN FindPath$ = LEFT$(Kurrent$,LEN(Kurrent$) - (i% - 1)) EXIT FOR END IF NEXT i% DefaultName$ = LTRIM$(Kurrent$,FindPath$) SELECT CASE Editkey% CASE -255 'exit was with mouse SELECT CASE MouseRow% CASE 4 'cancel box IF MouseCol% = 12 THEN Editkey% = 27 ReturnedFile$ = "" EXIT,EXIT END IF CASE 6 'line edit IF MouseCol% > 21 AND MouseCol% < 70 THEN Editkey% = 13 ReturnedFile$ = UCASE$(RTRIM$(Current$)) EXIT,EXIT END IF CASE 9 TO 12 'Dirs display SELECT CASE MouseCol% CASE 14 TO 24 IF DirStart% + MouseRow% - 9 <= DirCount% THEN DirPointer% = DirStart% + MouseRow% - 9 ELSE DirPointer% = DirCount% END IF GOTO MouseJumpToRepaint CASE 28 TO 38 IF DirStart% + 4 + MouseRow% - 9 <= DirCount% THEN DirPointer% = DirStart% + 4 + MouseRow% - 9 ELSE DirPointer% = DirCount% END IF GOTO MouseJumpToRepaint CASE 42 TO 52 IF DirStart% + 8 + MouseRow% - 9 <= DirCount% THEN DirPointer% = DirStart% + 8 + MouseRow% - 9 ELSE DirPointer% = DirCount% END IF GOTO MouseJumpToRepaint CASE 56 TO 66 IF DirStart% + 12 + MouseRow% - 9 <= DirCount% THEN DirPointer% = DirStart% + 12 + MouseRow% - 9 ELSE DirPointer% = DirCount% END IF GOTO MouseJumpToRepaint END SELECT CASE 13 'scroll bar IF MouseCol% > 51 AND MouseCol% < 68 THEN GOTO MouseJumpToDirs END IF CASE 15 'Save and Esc buttons SELECT CASE MouseCol% CASE 13 TO 19 'Save ReturnedFile$ = UCASE$(RTRIM$(Current$)) Editkey% = 13 EXIT,EXIT CASE 24 TO 28 'Esc ReturnedFile$ = "" Editkey% = 27 EXIT,EXIT END SELECT CASE ELSE 'return to loop END SELECT CASE 9 DO MouseJumpToDirs: IF OldDirPointer% THEN DirPointer% = OldDirPointer% ELSE DirPointer% = 1 END IF DO MouseJumpToRepaint: IF Mouse% THEN HideCursor GOSUB PrintDirs Editkey% = 255 'fall through LineEdit LineEdit Allow$,Current$,Mouse%,MouseRow%,MouseCol%,176,6,22,EditKey%,Attr% WHILE NOT INSTAT IF Mouse% THEN ShowCursor Rgt% = 0:Lft% = 0:MRow% = 0:MCol% = 0 Clicked Rgt%,Lft%,MRow%,MCol% SELECT CASE MRow% CASE 4 'cancel box IF MCol% = 12 THEN IF LeftButtonReleased% THEN ReturnedFile$ = "" Editkey% = 27 GOTO MouseJumpToExit END IF END IF CASE 6 'line edit IF MCol% > 21 AND MCol% < 70 THEN IF LeftButtonReleased% THEN Chose% = 9 GOTO MouseJumpToKeyBoard END IF END IF CASE 9 TO 12 'Dirs display SELECT CASE MCol% CASE 14 TO 24 IF Lft% THEN IF DirPointer% = DirStart% + MRow% - 9 THEN IF LeftButtonReleased% THEN Chose% = 13:GOTO MouseJumpToKeyBoard END IF ELSE IF DirStart% + MRow% - 9 <= DirCount% THEN DirPointer% = DirStart% + MRow% - 9 GOTO MouseJumpToRepaint END IF END IF END IF CASE 28 TO 38 IF Lft% THEN IF DirPointer% = DirStart% + 4 + MRow% - 9 THEN IF LeftButtonReleased% THEN Chose% = 13:GOTO MouseJumpToKeyBoard END IF ELSE IF DirStart% + 4 + MRow% - 9 <= DirCount% THEN DirPointer% = DirStart% + 4 + MRow% - 9 GOTO MouseJumpToRepaint END IF END IF END IF CASE 42 TO 52 IF Lft% THEN IF DirPointer% = DirStart% + 8 + MRow% - 9 THEN IF LeftButtonReleased% THEN Chose% = 13:GOTO MouseJumpToKeyBoard END IF ELSE IF DirStart% + 8 + MRow% - 9 <= DirCount% THEN DirPointer% = DirStart% + 8 + MRow% - 9 GOTO MouseJumpToRepaint END IF END IF END IF CASE 56 TO 66 IF Lft% THEN IF DirPointer% = DirStart% + 12 + MRow% - 9 THEN IF LeftButtonReleased% THEN Chose% = 13:GOTO MouseJumpToKeyBoard END IF ELSE IF DirStart% + 12 + MRow% - 9 <= DirCount% THEN DirPointer% = DirStart% + 12 + MRow% - 9 GOTO MouseJumpToRepaint END IF END IF END IF END SELECT CASE 13 'scroll bar SELECT CASE MCol% CASE 51 TO 52 IF DirCount% < 17 THEN IF LeftButtonReleased% THEN Chose% = -72:GOTO MouseJumpToKeyBoard END IF ELSE IF LeftButtonReleased% THEN Chose% = -75:GOTO MouseJumpToKeyBoard END IF END IF CASE 67 TO 68 IF DirCount% < 17 THEN IF LeftButtonReleased% THEN Chose% = -80:GOTO MouseJumpToKeyBoard END IF ELSE IF LeftButtonReleased% THEN Chose% = -77:GOTO MouseJumpToKeyBoard END IF END IF END SELECT CASE 15 'Save and Esc buttons SELECT CASE MCol% CASE 13 TO 19 'Save IF LeftButtonReleased% THEN ReturnedFile$ = UCASE$(RTRIM$(Current$)) Editkey% = 13 GOTO MouseJumpToExit END IF CASE 24 TO 28 'Esc IF LeftButtonReleased% THEN ReturnedFile$ = "" Editkey% = 27 GOTO MouseJumpToExit END IF END SELECT END SELECT END IF WEND Ky$ = INKEY$ IF LEN(Ky$) = 1 THEN Chose% = ASC(Ky$) ELSE Chose% = -ASC(RIGHT$(Ky$,1)) END IF MouseJumpToKeyBoard: SELECT CASE Chose% CASE -71 ' home IF DirPointer% < 16 THEN DirPointer% = 1 ELSE DirPointer% = 1 DirStart% = 1 DirFinish% = 16 END IF CASE -72 ' up arrow IF DirPointer% > 1 THEN DECR DirPointer% IF DirPointer% < DirStart% THEN DECR DirStart%:DECR DirFinish% END IF END IF CASE -75 ' left arrow IF DirPointer% - 4 > 0 THEN DECR DirPointer%,4 IF DirPointer% < DirStart% THEN IF DirStart% - 4 > 0 THEN DECR DirStart%,4:DECR DirFinish%,4 ELSE DirStart% = 1:DirFinish% = 16 END IF END IF ELSE IF DirCount% > 16 THEN DirStart% = 1:DirFinish% = 16 END IF END IF CASE -77 ' right arrow IF DirPointer% + 4 <= DirCount% THEN INCR DirPointer%,4 IF DirPointer% > DirFinish% THEN IF DirFinish% + 4 < DirCount% THEN INCR DirStart%,4:INCR DirFinish%,4 ELSE DirFinish% = DirCount% DirStart% = DirFinish% - 15 END IF END IF ELSE IF DirCount% > 16 THEN DirFinish% = DirCount% DirStart% = DirFinish% - 15 END IF END IF CASE -79 ' end key IF DirCount% < 16 THEN DirPointer% = DirCount% ELSE DirPointer% = DirCount% DirStart% = DirCount% - 15 DirFinish% = DirCount% END IF CASE -80 ' down arrow IF DirPointer% < DirCount% THEN INCR DirPointer% IF DirPointer% > DirFinish% THEN INCR DirStart%:INCR DirFinish% END IF END IF CASE 9 ' tab key OldDirPointer% = DirPointer% DirPointer% = 0 EXIT,EXIT,EXIT CASE 13 ' enter IF Directory$(DirPointer%) = ".." THEN Path$ = RTRIM$(Path$,CHR$(92)) FOR i% = 1 TO LEN(Path$) Test$ = RIGHT$(Path$,i%) IF LEFT$(Test$,1) = CHR$(92) THEN Current$ = LEFT$(Path$,LEN(Path$) - (i% - 1)) OldDirPointer% = 0:DirPointer% = 0 EXIT,EXIT,EXIT,EXIT END IF NEXT i% ELSE Current$ = Path$ + PasteIn$ OldDirPointer% = 0:DirPointer% = 0 EXIT,EXIT,EXIT END IF CASE 27 ' Esc Editkey% = 27 EXIT,EXIT,EXIT,EXIT CASE ELSE BEEP END SELECT LOOP LOOP CASE 13 ReturnedFile$ = UCASE$(RTRIM$(Current$)) EXIT,EXIT CASE 27 ReturnedFile$ = "" EXIT,EXIT END SELECT LOOP LOOP MouseJumpToExit: Row% = 15:Col% = 13 SELECT CASE Editkey% CASE 13 'Ok IF Mouse% THEN HideCursor COLOR FGround%,BGround% LOCATE Row%,Col%,0 PRINT " "; LOCATE Row% + 1,Col% + 1,0 PRINT " "; COLOR BtFG%,BtBG% LOCATE Row%,Col% + 1,0 PRINT " Enter " CASE 27 'Esc IF Mouse% THEN HideCursor COLOR FGround%,BGround% LOCATE Row%,Col% + 11,0 PRINT " "; LOCATE Row% + 1,Col% + 12,0 PRINT " "; COLOR BtFG%,BtBG% LOCATE Row%,Col% + 12,0 PRINT " Esc " END SELECT IF Mouse% THEN ShowCursor DELAY .5 IF Mouse% THEN HideCursor RestoreScreen DirScreen$,4,9 EXIT SUB '---------------------------------------------------------------------------- PrintDirs: Row% = 9 Col% = 14 FOR a% = DirStart% TO DirFinish% IF a% = DirStart% + 4 OR a% = DirStart% + 8 OR a% = DirStart% + 12 THEN Row% = 9:INCR Col%,14 IF a% = DirPointer% THEN COLOR BarFG%,BarBG% LOCATE Row%,Col%,0 IF LEN(Directory$(a%)) THEN z% = 92 ELSE z% = 32 END IF IF Directory$(a%) = ".." THEN PasteIn$ = "" ELSE PasteIn$ = Directory$(a%) + CHR$(92) END IF PRINT SPACE$(1) + Directory$(a%) + CHR$(z%) + SPACE$(9 - LEN(Directory$(a%))); ELSE COLOR FGround%,BGround% LOCATE Row%,Col%,0 IF LEN(Directory$(a%)) THEN z% = 92 ELSE z% = 32 END IF PRINT SPACE$(1) + Directory$(a%) + CHR$(z%) + SPACE$(9 - LEN(Directory$(a%))); END IF INCR Row% NEXT a% DirScrollBar% = DirCount% \ 14 IF DirScrollBar% < 1 THEN DirScrollBar% = 1 Bar% = 0 Col% = 52 IF DirPointer% THEN ScrollDirPointer% = DirPointer% ELSEIF OldDirPointer% THEN ScrollDirPointer% = OldDirPointer% ELSE ScrollDirPointer% = 1 END IF COLOR FGround%,BGround% LOCATE 13,13,0 PRINT "┤ ├"; COLOR BtFG%,BGround% LOCATE 13,14,0 PRINT ScrollDirPointer%; "of"; DirCount%; FOR a% = DirStart% TO DirFinish% COLOR FGround%,BGround% LOCATE 13,Col%,0 IF a% = DirStart% THEN PRINT CHR$(27); ELSEIF a% = DirFinish% THEN PRINT CHR$(26); ELSE IF Bar% = 0 THEN c% = ScrollDirPointer% FOR i% = 1 TO DirScrollBar% b% = c% \ DirScrollBar% IF a% = b% + DirStart% THEN Bar% = 1 EXIT FOR ELSE INCR c% END IF NEXT i% IF Bar% THEN PRINT CHR$(219); ELSE IF Bar% = 0 AND a% = DirFinish% - 1 THEN PRINT CHR$(219); ELSE PRINT CHR$(176); END IF END IF ELSE PRINT CHR$(176); END IF END IF INCR Col% NEXT a% RETURN '---------------------------------------------------------------------------- ErrorHandle: SELECT CASE ERR CASE 71 Message$(1) = " Disk Drive not Ready " CASE 76 Message$(1) = " Path or File not Found " END SELECT Dialog Message$(),"Error",Mouse%,2,9,25,BarFG%,ButtonAttr%,Shadow%,Border% RESUME NEXT '---------------------------------------------------------------------------- END SUB